home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #2 / Monster Media No. 2 (Monster Media)(1994).ISO / pcboard / scall121.zip / SAMCALL.PPE (.txt) < prev    next >
PCBoard Programming Language Executable  |  1994-05-29  |  10KB  |  494 lines
  1. ;------------------------------------------------------------------------------
  2. ;                                                   .ss.
  3. ;                                                   `²²'
  4. ;             .,sS$Ss,,s$  .,sS$$$Ss.  .,sS$Ss,,s$ .ss.  .sSs.
  5. ;           .d$$²^°²$$$$'.d$P²°^^²$P'.d$$²^°²$$$$'.$$$' .$$$²Sb,.
  6. ;           $$$'   .$$$' $$$²Sçsµ²' .$$$'   .$$$'.$$$' .$$$'  `$$b.
  7. ;           $$$b,,d$$$' ,$$$b,....,s$$$$b,,d$$$'.$$$;.,$$$'    ;$$$
  8. ;           `²S$$S²²S$$S²°²S$$$$S²°°²S$$$$$$',$$S²°²S$S'.sS$$$P²'
  9. ;                                    .sS²°$$$²²°"'       d²°'
  10. ;                                  .$$²  .$$'
  11. ;                                  $$$.,d$$'
  12. ;                                  `²S$$S²'
  13. ;------------------------------------------------------------------------------
  14. ; P.P.L.X. 2.OO                          (C)1996 - Lone Runner / AEGiS CoRP'96 
  15. ;------------------------------------------------------------------------------
  16. ; PPE 1.OO (plain) - Analysis ON - Postprocessing ON
  17. ;------------------------------------------------------------------------------
  18.  
  19.     Boolean  BOOLEAN001
  20.     Boolean  BOOLEAN002
  21.     Boolean  BOOLEAN003
  22.     Integer  INTEGER001
  23.     Integer  INTEGER002
  24.     String   STRING001
  25.     String   STRING002
  26.     String   STRING003
  27.     String   TSTRING004(2)
  28.     String   TSTRING005(5)
  29.     String   TSTRING006(9)
  30.     String   STRING007
  31.     String   TSTRING008(12)
  32.     String   STRING009
  33.     String   STRING010
  34.  
  35. ;------------------------------------------------------------------------------
  36.  
  37.     STRING010 = "@X0F───────────────────────────────────────────────────────────────────@X07"
  38.     STRING002 = "      "
  39.     STRING007 = "@X0E(@X0C@MINLEFT@ left@X0E) H)elp, Callsign, M)essage or ENTER = Quit"
  40.     STRING009 = Year(Date())
  41.     STRING003 = "SamCall " + Chr(67) + Chr(111) + Chr(112) + Chr(121) + Chr(114) + Chr(105) + Chr(103) + Chr(104) + Chr(116) + Chr(32) + Chr(49) + Chr(57) + Chr(57) + Chr(51) + Chr(45) + STRING009 + Chr(32) + Chr(98) + Chr(121) + Chr(32) + Chr(66) + Chr(105) + Chr(108) + Chr(108) + Chr(32) + Chr(83) + Chr(104) + Chr(114) + Chr(121) + Chr(111) + Chr(99) + Chr(107) + Chr(44) + Chr(32) + Chr(87) + Chr(68) + Chr(48) + Chr(71) + Chr(82) + Chr(67)
  42.     BOOLEAN002 = 0
  43.     BOOLEAN003 = 0
  44.     TSTRING004(1) = "                                               SamCall Version 1.21    "
  45.     TSTRING004(2) = "Version 1.21"
  46.     If (Exist(PPEPath() + "SAMCALL.CFG")) Then
  47.         TSTRING005(1) = Trim(ReadLine(PPEPath() + "SAMCALL.CFG", 1), " ")
  48.         TSTRING005(2) = Trim(ReadLine(PPEPath() + "SAMCALL.CFG", 2), " ")
  49.         TSTRING005(3) = Trim(ReadLine(PPEPath() + "SAMCALL.CFG", 3), " ")
  50.         TSTRING005(4) = Trim(ReadLine(PPEPath() + "SAMCALL.CFG", 4), " ")
  51.         TSTRING005(5) = Trim(ReadLine(PPEPath() + "SAMCALL.CFG", 5), " ")
  52.         INTEGER002 = 1
  53.         For INTEGER001 = 1 To Len(TSTRING005(4))
  54.             INTEGER002 = Abs(INTEGER002 + Asc(Mid(TSTRING005(4), INTEGER001, 1)))
  55.             INTEGER002 = Abs(INTEGER002 + And(INTEGER001, Asc(Mid(TSTRING005(4), INTEGER001, 1))))
  56.             INTEGER002 = Abs(INTEGER002 + XOr(INTEGER001, Asc(Mid(TSTRING005(4), INTEGER001, 1))))
  57.         Next
  58.         INTEGER002 = Abs(INTEGER002 * XOr(24, Asc(Left(TSTRING005(4), 1))))
  59.         INTEGER002 = INTEGER002 + 183630
  60.         If (INTEGER002 == S2I(TSTRING005(5), 10)) Then
  61.             INTEGER002 = 1
  62.         Else
  63.             INTEGER002 = 0
  64.         Endif
  65.         If (INTEGER002) Then
  66.             STRING001 = "Registered to: " + TSTRING005(4)
  67.         Else
  68.             STRING001 = Chr(85) + Chr(110) + Chr(45) + Chr(82) + Chr(101) + Chr(103) + Chr(105) + Chr(115) + Chr(116) + Chr(101) + Chr(114) + Chr(101) + Chr(100) + Chr(32) + Chr(69) + Chr(118) + Chr(97) + Chr(108) + Chr(117) + Chr(97) + Chr(116) + Chr(105) + Chr(111) + Chr(110) + Chr(32) + Chr(67) + Chr(111) + Chr(112) + Chr(121) + Chr(46)
  69.         Endif
  70.     Else
  71.         Cls
  72.         AnsiPos 1, 10
  73.         PrintLn "Please Notify the Sysop..."
  74.         PrintLn "Unable to locate SAMCALL.CFG file in " + PPEPath()
  75.         AnsiPos 1, 15
  76.         Wait
  77.         Stop
  78.     Endif
  79.     If (Exist(TempPath() + "OUTFILE.$$$")) Then
  80.         Delete TempPath() + "OUTFILE.$$$"
  81.     Endif
  82.     FOpen 1, TempPath() + "OUTFILE.$$$", 1, 0
  83.     FPutLn 1, "@X0ECallsign data from the SAM Database by SamCall " + TSTRING004(2) + "@X07"
  84.     FPutLn 1, "@X0E" + STRING003 + "@X07"
  85.     FPutLn 1, " "
  86.     FPutLn 1, "@X0B" + STRING001
  87.     FPutLn 1, " "
  88.     FPutLn 1, STRING010
  89.     FPutLn 1, " "
  90.     :LABEL001
  91.     If (AnsiOn()) Then
  92.         Cls
  93.         AnsiPos 40 - Len(TSTRING005(1)) / 2, 2
  94.         Color 14
  95.         PrintLn TSTRING005(1)
  96.         AnsiPos 40 - Len(TSTRING005(2)) / 2, 3
  97.         Color 7
  98.         PrintLn TSTRING005(2)
  99.         AnsiPos 40 - Len(TSTRING005(3)) / 2, 4
  100.         Color 11
  101.         PrintLn TSTRING005(3)
  102.         AnsiPos 40 - Len(STRING003) / 2, 6
  103.         Color 15
  104.         PrintLn STRING003
  105.         AnsiPos 5, 8
  106.         Color 30
  107.         PrintLn " ╔═══════════════════════════════════════════════════════════════════╗ "
  108.         For INTEGER001 = 1 To 7
  109.             AnsiPos 5, 8 + INTEGER001
  110.             Color 30
  111.             Print " ║                                                                   ║ "
  112.             Color 127
  113.             PrintLn "  "
  114.         Next
  115.         AnsiPos 5, 16
  116.         Color 30
  117.         Print " ╚═══════════════════════════════════════════════════════════════════╝ "
  118.         Color 127
  119.         PrintLn "  "
  120.         AnsiPos 7, 17
  121.         Color 127
  122.         PrintLn TSTRING004(1)
  123.         Color 11
  124.         AnsiPos 40 - Len(STRING001) / 2, 19
  125.         PrintLn STRING001
  126.         PrintLn " "
  127.     Else
  128.         PrintLn " "
  129.         PrintLn TSTRING005(1)
  130.         PrintLn TSTRING005(2)
  131.         PrintLn TSTRING005(3)
  132.         PrintLn STRING003
  133.         PrintLn TSTRING004(2)
  134.         PrintLn STRING001
  135.         PrintLn " "
  136.     Endif
  137.     :LABEL002
  138.     If (BOOLEAN001) Goto LABEL007
  139.     BOOLEAN001 = 0
  140.     While (STRING009 <> "") Do
  141.         STRING009 = Inkey()
  142.     EndWhile
  143.     If (AnsiOn()) Then
  144.         AnsiPos 1, 22
  145.         InputText STRING007, STRING002, 15, 6
  146.     Else
  147.         PrintLn " "
  148.         InputStr STRING007, STRING002, 15, 6, Mask_Num() + Mask_Alpha(), 8
  149.     Endif
  150.     If (STRING002 == "") Then
  151.         BOOLEAN001 = 1
  152.     Endif
  153.     STRING002 = Upper(STRING002)
  154.     If (((((STRING002 == "?") || (STRING002 == "H")) || (STRING002 == "HE")) || (STRING002 == "HEL")) || (STRING002 == "HELP")) Then
  155.         STRING002 = ""
  156.         Cls
  157.         DispFile HelpPath() + "SAMCALL", 0
  158.         Wait
  159.         Goto LABEL001
  160.     Endif
  161.     If (STRING002 == "G") Then
  162.         FClose 1
  163.         FClose 2
  164.         If (Exist(TempPath() + "OUTFILE.$$$")) Then
  165.             Delete TempPath() + "OUTFILE.$$$"
  166.         Endif
  167.         If (Exist(PPEPath() + "FOUND.$$$")) Then
  168.             Delete PPEPath() + "FOUND.$$$"
  169.         Endif
  170.         Bye
  171.     Endif
  172.     If (STRING002 == "M") Then
  173.         STRING002 = ""
  174.         BOOLEAN001 = 1
  175.         If (BOOLEAN002) Then
  176.             PrintLn 
  177.             PrintLn 
  178.             PrintLn "@X0ECreating a private message to " + U_Name() + "@X07"
  179.             FClose 1
  180.             Message 0, U_Name(), "SamCall", "Calls from Sam Data Base", "R", Date(), 0, 0, TempPath() + "OUTFILE.$$$"
  181.             Goto LABEL003
  182.         Endif
  183.         PrintLn 
  184.         PrintLn 
  185.         PrintLn Chr(7) + "@X0CNo Callsign data to save.@X07"
  186.         PrintLn 
  187.         Wait
  188.     Endif
  189.     :LABEL003
  190.     If (BOOLEAN001) Goto LABEL006
  191.     FClose 2
  192.     If (Exist(PPEPath() + "FOUND.$$$")) Then
  193.         Delete PPEPath() + "FOUND.$$$"
  194.     Endif
  195.     STRING009 = PPEPath() + "SCALL.EXE"
  196.     If (Exist(PPEPath() + "SCALL.EXE")) Then
  197.         If (FileInf(STRING009, 4) == 13216) Then
  198.             Shell 1, INTEGER001, PPEPath() + "SCALL.EXE ", STRING002 + " > " + PPEPath() + "FOUND.$$$"
  199.         Else
  200.             Cls
  201.             AnsiPos 1, 10
  202.             PrintLn "Please notify the Sysop..."
  203.             PrintLn "The version of SCALL.EXE in " + PPEPath()
  204.             PrintLn "is not the version distributed with SamCall."
  205.             AnsiPos 1, 16
  206.             Wait
  207.             Stop
  208.         Endif
  209.     Else
  210.         Cls
  211.         AnsiPos 1, 10
  212.         PrintLn "Please notify the Sysop..."
  213.         PrintLn "Unable to locate SCALL.EXE file in " + PPEPath()
  214.         AnsiPos 1, 15
  215.         Wait
  216.         Stop
  217.     Endif
  218.     If (Exist(PPEPath() + "FOUND.$$$")) Then
  219.         FOpen 2, PPEPath() + "FOUND.$$$", 0, 0
  220.         INTEGER001 = 1
  221.         While (INTEGER001 < 13) Do
  222.             FGet 2, TSTRING008(INTEGER001)
  223.             Inc INTEGER001
  224.         EndWhile
  225.         FClose 2
  226.     Else
  227.         Cls
  228.         AnsiPos 1, 6
  229.         PrintLn "Please notify the Sysop..."
  230.         PrintLn "Unable to locate data file " + Chr(34) + "FOUND.$$$" + Chr(34) + " in " + PPEPath()
  231.         PrintLn "This file should have been created by SCALL.EXE, Samcall was"
  232.         PrintLn "unable to locate the data necessary to continue."
  233.         PrintLn "SAMAPI.EXE may not be installed correctly."
  234.         AnsiPos 1, 15
  235.         Wait
  236.         Stop
  237.     Endif
  238.     If (AnsiOn()) Then
  239.         AnsiPos 40 - Len(TSTRING005(1)) / 2, 2
  240.         Color 14
  241.         SPrintLn TSTRING005(1)
  242.         AnsiPos 40 - Len(TSTRING005(2)) / 2, 3
  243.         Color 7
  244.         SPrintLn TSTRING005(2)
  245.         AnsiPos 40 - Len(TSTRING005(3)) / 2, 4
  246.         Color 11
  247.         SPrintLn TSTRING005(3)
  248.         AnsiPos 40 - Len(STRING003) / 2, 6
  249.         Color 15
  250.         SPrintLn STRING003
  251.         AnsiPos 5, 8
  252.         Color 30
  253.         SPrintLn " ╔═══════════════════════════════════════════════════════════════════╗ "
  254.         For INTEGER001 = 1 To 7
  255.             AnsiPos 5, 8 + INTEGER001
  256.             Color 30
  257.             SPrint " ║                                                                   ║ "
  258.             Color 127
  259.             SPrintLn "  "
  260.         Next
  261.         AnsiPos 5, 16
  262.         Color 30
  263.         SPrint " ╚═══════════════════════════════════════════════════════════════════╝ "
  264.         Color 127
  265.         SPrintLn "  "
  266.         AnsiPos 7, 17
  267.         Color 127
  268.         SPrintLn TSTRING004(1)
  269.         Color 11
  270.         AnsiPos 40 - Len(STRING001) / 2, 19
  271.         SPrintLn STRING001
  272.         SPrintLn " "
  273.     Else
  274.         PrintLn ""
  275.     Endif
  276.     If (InStr(TSTRING008(1), "No data for")) Then
  277.         If (AnsiOn()) Then
  278.             AnsiPos 9, 10
  279.             Print "@X1F*** Call ", STRING002, " Not Found.", Space(45 - Len(STRING002))
  280.             AnsiPos 9, 11
  281.             Print "@X1F", Space(64)
  282.             AnsiPos 9, 12
  283.             Print "@X1F", Space(64)
  284.             AnsiPos 9, 13
  285.             Print "@X1F", Space(64)
  286.             AnsiPos 9, 14
  287.             Print "@X1F", Space(64)
  288.         Else
  289.             Newline
  290.             PrintLn "*** Call ", STRING002, " Not Found."
  291.         Endif
  292.     Else
  293.         BOOLEAN002 = 1
  294.         BOOLEAN003 = 1
  295.         For INTEGER001 = 1 To 12
  296.             TSTRING008(INTEGER001) = TSTRING008(INTEGER001) + Space(80)
  297.         Next
  298.         If (Left(TSTRING008(5), 6) == "Class:") Then
  299.             STRING009 = Mid(TSTRING008(5), 8, 1)
  300.             If (STRING009 == "E") Then
  301.                 TSTRING008(5) = "Class   : Extra"
  302.                 Goto LABEL004
  303.             Endif
  304.             If (STRING009 == "A") Then
  305.                 TSTRING008(5) = "Class   : Advanced"
  306.                 Goto LABEL004
  307.             Endif
  308.             If (STRING009 == "G") Then
  309.                 TSTRING008(5) = "Class   : General"
  310.                 Goto LABEL004
  311.             Endif
  312.             If (STRING009 == "T") Then
  313.                 TSTRING008(5) = "Class   : Technician"
  314.                 Goto LABEL004
  315.             Endif
  316.             If (STRING009 == "N") Then
  317.                 TSTRING008(5) = "Class   : Novice"
  318.                 Goto LABEL004
  319.             Endif
  320.             If (STRING009 == "C") Then
  321.                 TSTRING008(5) = "Class   : Club Call"
  322.                 Goto LABEL004
  323.             Endif
  324.             If (STRING009 == "M") Then
  325.                 TSTRING008(5) = "Class   : Military"
  326.             Endif
  327.         Endif
  328.         :LABEL004
  329.         If (Left(TSTRING008(11), 7) == "County:") Then
  330.             TSTRING008(11) = "County  : " + Mid(TSTRING008(11), 9, 20)
  331.         Endif
  332.         If (Len(Trim(TSTRING008(7), " ")) > 4) Then
  333.             If (Left(TSTRING008(6), 8) <> "Birthday") Then
  334.                 INTEGER001 = S2I(Mid(TSTRING008(7), 12, 4) + 5, 10)
  335.                 If (INTEGER001 > S2I(Mid(Date(), 7, 2), 10)) Then
  336.                     INTEGER001 = S2I(Left(Year(Date()), 2), 10) - 1
  337.                     Goto LABEL005
  338.                 Endif
  339.                 INTEGER001 = S2I(Left(Year(Date()), 2), 10)
  340.                 :LABEL005
  341.                 TSTRING008(6) = "YearBorn: " + I2S(INTEGER001, 10) + Mid(TSTRING008(7), 12, 4)
  342.             Endif
  343.         Endif
  344.         TSTRING006(1) = Left(Left(TSTRING008(1) + Space(40), 40) + TSTRING008(6), 64)
  345.         TSTRING006(2) = Left(Left(TSTRING008(2) + Space(40), 40) + TSTRING008(8), 64)
  346.         TSTRING006(3) = Left(Left(TSTRING008(3) + Space(40), 40) + TSTRING008(9), 64)
  347.         TSTRING006(4) = Left(Left(TSTRING008(4) + Space(40), 40) + TSTRING008(11), 64)
  348.         TSTRING006(5) = Left(Left(TSTRING008(12) + Space(40), 40) + TSTRING008(5), 64)
  349.         If (AnsiOn()) Then
  350.             AnsiPos 9, 10
  351.             Print "@X1F", TSTRING006(1)
  352.             AnsiPos 9, 11
  353.             Print "@X1F", TSTRING006(2)
  354.             AnsiPos 9, 12
  355.             Print "@X1F", TSTRING006(3)
  356.             AnsiPos 9, 13
  357.             Print "@X1F", TSTRING006(4)
  358.             AnsiPos 9, 14
  359.             Print "@X1F", TSTRING006(5)
  360.         Else
  361.             Newline
  362.             PrintLn TSTRING006(1)
  363.             PrintLn TSTRING006(2)
  364.             PrintLn TSTRING006(3)
  365.             PrintLn TSTRING006(4)
  366.             PrintLn TSTRING006(5)
  367.             Newline
  368.         Endif
  369.     Endif
  370.     If (BOOLEAN003) Then
  371.         For INTEGER001 = 1 To 5
  372.             FPutLn 1, " " + TSTRING006(INTEGER001)
  373.         Next
  374.         FPutLn 1, " "
  375.         FPutLn 1, STRING010
  376.         FPutLn 1, " "
  377.         BOOLEAN003 = 0
  378.     Endif
  379.     STRING002 = "      "
  380.     For INTEGER001 = 1 To 9
  381.         TSTRING006(INTEGER001) = ""
  382.     Next
  383.     :LABEL006
  384.     Goto LABEL002
  385.     :LABEL007
  386.     FClose 1
  387.     FClose 2
  388.     If (Exist(TempPath() + "OUTFILE.$$$")) Then
  389.         Delete TempPath() + "OUTFILE.$$$"
  390.     Endif
  391.     If (Exist(PPEPath() + "FOUND.$$$")) Then
  392.         Delete PPEPath() + "FOUND.$$$"
  393.     Endif
  394.     Stop
  395.  
  396. ;------------------------------------------------------------------------------
  397. ;
  398. ; Usage report (before postprocessing)
  399. ;
  400. ; ■ Statements used :
  401. ;
  402. ;    6       Cls
  403. ;    6       Wait
  404. ;    22      Color 
  405. ;    76      Goto 
  406. ;    69      Let 
  407. ;    12      Print 
  408. ;    45      PrintLn 
  409. ;    46      If 
  410. ;    1       DispFile 
  411. ;    2       FOpen 
  412. ;    7       FClose 
  413. ;    1       FGet 
  414. ;    11      FPutLn 
  415. ;    6       Delete 
  416. ;    1       InputStr 
  417. ;    1       Inc 
  418. ;    3       Newline
  419. ;    1       Shell 
  420. ;    5       Stop
  421. ;    1       InputText 
  422. ;    1       Bye
  423. ;    37      AnsiPos 
  424. ;    1       Message 
  425. ;    2       SPrint 
  426. ;    10      SPrintLn 
  427. ;
  428. ;
  429. ; ■ Functions used :
  430. ;
  431. ;    1       *
  432. ;    10      /
  433. ;    144     +
  434. ;    12      -
  435. ;    19      ==
  436. ;    2       <>
  437. ;    7       <
  438. ;    6       <=
  439. ;    2       >
  440. ;    12      >=
  441. ;    46      !
  442. ;    12      &&
  443. ;    10      ||
  444. ;    14      Len(
  445. ;    1       Upper()
  446. ;    8       Mid()
  447. ;    16      Left()
  448. ;    11      Space()
  449. ;    72      Chr()
  450. ;    4       Asc()
  451. ;    1       InStr()
  452. ;    6       Trim()
  453. ;    5       Date()
  454. ;    2       U_Name()
  455. ;    3       Year()
  456. ;    1       Inkey()
  457. ;    1       Mask_Alpha()
  458. ;    1       Mask_Num()
  459. ;    22      PPEPath()
  460. ;    5       ReadLine()
  461. ;    9       Exist()
  462. ;    1       I2S()
  463. ;    5       S2I()
  464. ;    5       AnsiOn()
  465. ;    1       And()
  466. ;    2       XOr()
  467. ;    4       Abs()
  468. ;    1       FileInf()
  469. ;    1       HelpPath()
  470. ;    8       TempPath()
  471. ;
  472. ;------------------------------------------------------------------------------
  473. ;
  474. ; Analysis flags : S
  475. ;
  476. ; S - Shell to DOS ■ 5
  477. ;     This may be normal if the PPE need to execute an external command,
  478. ;     but may be actually anything... nasty (formating HD, rebooting,...)
  479. ;     or usefull (sorting, maintenance,...). Check!
  480. ;     ■ Search for : SHELL
  481. ;
  482. ;------------------------------------------------------------------------------
  483. ;
  484. ; Postprocessing report
  485. ;
  486. ;    6       For/Next
  487. ;    2       While/EndWhile
  488. ;    36      If/Then or If/Then/Else
  489. ;    0       Select Case
  490. ;
  491. ;------------------------------------------------------------------------------
  492. ;                 AEGiS Corp - Break the routines, code against the machines!
  493. ;------------------------------------------------------------------------------
  494.